Optional texturebanks.f

Requires SDL
Requires Tools
Requires Seki
Requires SORA\Images2
Requires Vectors
Requires GL-Tools

Only Forth Definitions
Also SDL-Surfaces

/Image Inherit
   64 cells field ->sections
End-Struct /Texbank

{
0 value bank-gran-x
0 value bank-gran-y
0 value current-section

: slocate ( section -- x y )
  dup %111 and 8 lshift swap %111000 and 5 lshift ;

: texturebank-section ( section# gran-x. gran-y. -- )
  2dup to bank-gran-y to bank-gran-x rot to current-section
  glMatrixMode( GL_TEXTURE )
  glLoadIdentity
  current-section slocate swap s>f s>f 0e gltranslatef
  swap glscaled(  1e 2048e f/ .>f f*   1e 2048e f/ .>f f*   1e ) ;

: section-granularity ( gran-x. gran-y. -- )
  current-section -rot texturebank-section ;

}

\ Adds X and Y to the X and Y of each subimage in an image, also storing what the offset is
\   in ->TEXTURE-X and ->TEXTURE-Y.
: offset-subimages   ( image x y -- )
   third ->subimages @ if
      3dup rot ->texture-x 2v!   \ store current offset
      rot a! begin
         a@ h@ $FFFF <> while
         over a@ h+!
         dup a@ 2 + h+!
         12 +a
      repeat 2drop
   else
      3drop
   then ;

:macro texbank-surface@   ->surface @ ;

Variable dest-rect

\ Loads the images described in a texbank, constructing one large surface out of them.
\   Also transforms subimage coordinates by their location in the texbank.
: init-texbank ( texbank -- )
  dup texbank-surface@  locals| s |
  ->sections
  8 0 do
    8 0 do
      i 256 * dest-rect h!
       j 256 * dest-rect 2 + h!      \ write x y of dest rect
       @+ ?dup if
          \ dup i j offset-subimages
          ->surface @ 0 s dest-rect SDL_BlitSurface
      then
    loop
  loop
  s sdl-colorkey-alpha drop
  drop ;

\ Table of 64 cells must follow
: Texbank: ( -- <name> )
   2048 2048 Image: ;
